Проект SQL: Отток клиентов из банка

Задача

Я выбрал первую задачу:

• анализ того, почему клиенты банка не заключают новые договоры

С точки зрения потенциального заказчика нужно:

• определить, какие группы клиентов чаще всего уходят
• спрогнозировать возможные изменения в оттоке клиентов при улучшении качества банковских услуг или при предложении клиенту услуг, ранее не использованных им

Это нужно сделать, чтобы путем определенных действий уменьшить поток оттока клиентов, чтобы увеличить прибыль банка.

Анализ

Данные и логика анализа

Подключение к базе.

library(DBI)
library(RMariaDB)
con <- dbConnect(RMariaDB::MariaDB(), 
                 user='student2022minor', 
                 password='DataMinorHSE!2020', 
                 dbname='bank', 
                 host='hsepiterdata-1.cqq6v5igyw1z.us-east-2.rds.amazonaws.com',
                 port = 3315)
dbListTables(con)

## [1] "country"   "profile"   "portfolio"

В этом проекте мы будем работать с таблицами “country”, “profile” и “portfolio” Давайте посмотрим, какие группы клиентов чаще всего уходят из банка.

exited = dbGetQuery(con, "SELECT Exited, Gender, Age, EstimatedSalary, Tenure, 
                          Balance, NumOfProducts, HasCrCard, CreditScore
                         FROM portfolio INNER JOIN profile
                         ON portfolio.CustomerId = profile.CustomerId")

Преобразуем типы

library(dplyr)
exited = exited %>% 
  mutate(Exited = case_when(Exited == 0 ~ "No", 
                            TRUE ~ "Yes")) %>% 
  mutate(HasCrCard = case_when(HasCrCard == 0 ~ "No",
                               TRUE ~ "Yes"))
exited = exited %>% mutate_if(is.character, as.factor)

Преобразуем факторы в числа (дамми-переменные)

exitedNum = fastDummies::dummy_cols(exited, remove_first_dummy = TRUE)
exitedNum = exitedNum %>% select(-Exited, -Gender, -HasCrCard)

Считаем разделение на кластеры

set.seed(666)
km = kmeans(scale(exitedNum), centers = 5)
exitedNum$cluster = km$cluster

И финальное описание

exitedNum %>% group_by(cluster) %>% summarise_all(mean)

## # A tibble: 5 × 10
##   cluster   Age Estimat…¹ Tenure Balance NumOf…² Credi…³ Exite…⁴ Gende…⁵ HasCr…⁶
##     <int> <dbl>     <dbl>  <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
## 1       1  37.4    99664.   5.14 108546.    1.31    651. 0         1       1    
## 2       2  37.4    99015.   5.16   2104.    2.07    653. 3.74e-2   0.563   0.989
## 3       3  37.5   100381.   4.91 105386.    1.32    651. 0         0       1    
## 4       4  45.0   101086.   4.94  93772.    1.41    645. 1   e+0   0.439   0.693
## 5       5  37.5   100353.   4.91  74558.    1.53    652. 4.31e-4   0.568   0    
## # … with abbreviated variable names ¹​EstimatedSalary, ²​NumOfProducts,
## #   ³​CreditScore, ⁴​Exited_Yes, ⁵​Gender_Male, ⁶​HasCrCard_Yes

Мы можем наблюдать кластер под номером 4, где все клиенты ушли из банка. Из отличительных показателей этого кластера можно отметить:

• возраст - он в среднем выше, чем в других кластерах

• кредитный скоринг клиента - он в среднем меньше, чем в других кластерах

• пол - в среднем чаще уходят женщины (вывод сделан на основе того, что Gender_Male меньше половины)

• есть ли кредитная карта - у ушедших клиентов в среднем меньше кредитных карт, чем в остальных кластерах, за исключением 5.

Посмотрим, правда ли, что женщины в целом уходят чаще из банка

data4 = dbGetQuery(con, "SELECT Exited, COUNT(*) AS n
                         FROM portfolio
                         GROUP BY Exited")

data5 = dbGetQuery(con, "SELECT Gender, COUNT(*) AS n
                         FROM portfolio INNER JOIN profile
                         ON portfolio.CustomerId = profile.CustomerId
                         WHERE Exited = 0
                         GROUP BY Gender")

data6 = dbGetQuery(con, "SELECT Gender, COUNT(*) AS n
                         FROM portfolio INNER JOIN profile
                         ON portfolio.CustomerId = profile.CustomerId
                         WHERE Exited = 1
                         GROUP BY Gender")

library(plotly)
plot_ly(
  labels = c("Total", "Did not exit", "Exited", "Female", "Male",
             "Female ", "Male "),
  parents = c("", "Total", "Total", "Did not exit", "Did not exit", "Exited", "Exited"),
  values = c(sum(data4$n), data4$n, data5$n, data6$n),
  type = 'sunburst',
  branchvalues = 'total'
)

Несмотря на то, что женщин в целом меньше, чем мужчин, они действительно уходят больше. На это обязательно стоит обратить внимание в дальнейшем!

Подводя итоги анализа на данный момент, для дальнейшего анализа стоит взять взять подгруппу со следующими критериями:

1. Женщины

2. Возраст выше среднего

3. Кредитный скоринг меньше среднего

Посчитаем медиану для возраста

res_age = dbGetQuery(con, "SELECT profile.CustomerId AS CustomerId, SUM(Age) AS TotalAge
                 FROM profile INNER JOIN portfolio 
                 ON profile.CustomerId = portfolio.CustomerId
                 GROUP BY profile.CustomerId")

median_age = median(res_age$TotalAge)
median_age

## [1] 37

Медианный возраст составил 37 лет. Следовательно, будем фильтровать нашу подгруппу с условием, что возраст должен быть больше 37.

Теперь посчитаем медиану для кредитного скоринга

res_cs = dbGetQuery(con, "SELECT profile.CustomerId AS CustomerId, SUM(CreditScore) AS TotalCS
                 FROM profile INNER JOIN portfolio 
                 ON profile.CustomerId = portfolio.CustomerId
                 GROUP BY profile.CustomerId")

median_cs = median(res_cs$TotalCS)
median_cs

## [1] 652

Медианный кредитный скоринг составил 652. Значит, будем фильтровать нашу подгруппу с условием, что кредитный скоринг должен быть меньше 652.

Теперь можем создать датафрейм со всеми нашими условиями и переменными для дальнейшего анализа.

final_exited = dbGetQuery(con, "SELECT Exited, Gender, Age, EstimatedSalary, Tenure, 
                          Balance, NumOfProducts, HasCrCard, CreditScore
                          FROM profile INNER JOIN portfolio 
                          ON profile.CustomerId = portfolio.CustomerId
                          GROUP BY profile.CustomerId
                          HAVING Gender = 'Female' AND Age > 37 AND CreditScore < 652")

Модель

Больше нам не нужно соединение с базой, поэтому закрываем соединение

dbDisconnect(con)

Преобразуем переменные character в factor и уберем переменную Gender, так как у нас все женщины

final_exited = final_exited %>% mutate_if(is.character, as.factor)
final_exited$Exited = as.factor(final_exited$Exited)
final_exited = final_exited %>% select(-Gender)

Строим модель “дерево”

library(partykit)
library(caret)
set.seed(100)
ind = createDataPartition(final_exited$Exited, p = 0.8, list = F)
train = final_exited[ind,]
test = final_exited[-ind,]

treemodel = ctree(Exited~., data = train)
plot(treemodel)

Мы можем заметить, что разбиение основывается на возрасте, но мы с ним ничего не можем сделать для уменьшения оттока. Нехороший знак…

Оцениваем качество модели

predTest = predict(treemodel, test)
confusionMatrix(predTest, test$Exited)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 89 36
##          1 50 57
##                                           
##                Accuracy : 0.6293          
##                  95% CI : (0.5637, 0.6916)
##     No Information Rate : 0.5991          
##     P-Value [Acc > NIR] : 0.1922          
##                                           
##                   Kappa : 0.247           
##                                           
##  Mcnemar's Test P-Value : 0.1610          
##                                           
##             Sensitivity : 0.6403          
##             Specificity : 0.6129          
##          Pos Pred Value : 0.7120          
##          Neg Pred Value : 0.5327          
##              Prevalence : 0.5991          
##          Detection Rate : 0.3836          
##    Detection Prevalence : 0.5388          
##       Balanced Accuracy : 0.6266          
##                                           
##        'Positive' Class : 0               
## 

В целом чутка лучше, чем рандомно самому определять классы (где accuracy составила бы 0.5 по теории вероятности), поэтому можем работать дальше

Построим модель логистической регрессии и оценим ее качество

library(tidymodels)
set.seed(100)
model = logistic_reg()
logreg = model %>% fit(Exited~., data = train)
predlog = predict(logreg, test)

table(predlog$.pred_class, test$Exited)

##    
##       0   1
##   0 122  70
##   1  17  23

test %>% 
  mutate(pred =predlog$.pred_class) %>% 
  conf_mat(estimate = pred, truth = Exited) %>% 
  summary()

## # A tibble: 13 × 3
##    .metric              .estimator .estimate
##    <chr>                <chr>          <dbl>
##  1 accuracy             binary         0.625
##  2 kap                  binary         0.138
##  3 sens                 binary         0.878
##  4 spec                 binary         0.247
##  5 ppv                  binary         0.635
##  6 npv                  binary         0.575
##  7 mcc                  binary         0.162
##  8 j_index              binary         0.125
##  9 bal_accuracy         binary         0.563
## 10 detection_prevalence binary         0.828
## 11 precision            binary         0.635
## 12 recall               binary         0.878
## 13 f_meas               binary         0.737

Здесь accuracy чуть поменьше, чем в предыдущей модели

Давайте оценим важность признаков

library(vip)
vip(treemodel)

vip(logreg)

У логистической регрессии гораздо больше важных переменных, по сравнению с деревом решений. Для дальнейшей симуляции будем использовать поэтому логистическую регрессию

Давайте посмотрим на распределение одного из важных признаков в логистической регрессии - NumOfProducts (количество продуктов у клиента) - в зависимости от того, уходил ли клиент или нет (смотрим и тестовую, и тренировочную выборки)

ggplot(train) + geom_bar(aes(x = NumOfProducts, fill = Exited), position = "fill")

ggplot(test) + geom_bar(aes(x = NumOfProducts, fill = Exited), position = "fill")

Можем заметить, что покинувшие банк клиенты чаще всего имеют 1 или 2 продукта от банка. Справедливости ради стоит также обратить внимание на то, что клиентов с 3 или 4 продуктами намного меньше, чем с 1 или 2, но при этом действитетельно их обладатели больше склонны уходить из банка.

Симуляция

Давайте попробуем увеличить количество продуктов на 1 для тех клиентов, у кого на момент до преобразования уже был 1 продукт (выглядит как акция для недавно присоединившихся клиентов). Допустим, что наш банк предлагает самые выгодные условия для открытия вклада на всем банковском рынке, если у клиента открыт счет или есть кредит в банке (как раз 1 продукт). Предположим, что наши условия сработали в 15% случаев.

set.seed(666)
test2 = test
test2$NumOfProducts[test2$NumOfProducts == 1] = 
  sample(c(1, 2), 
         size = length(test2$NumOfProducts[test2$NumOfProducts == 1]),
         replace = T, prob = c(0.85, 0.15))

predTest2 = predict(logreg, test2)$.pred_class
ggplot(data.frame(predTest)) + geom_bar(aes(x = predTest), alpha = 0.5, fill = "red") +
   geom_bar(data = data.frame(predTest2), aes(x = predTest2), alpha = 0.5, fill = "blue") +
  geom_bar(data = test, aes(x = Exited), alpha = 0.5)

Можем заметить, что после симуляции модель предсказывает, что больше клиентов остается у банка. Красный цвет показывает результаты до симуляции, а синий цвет - после симуляции (фиолетовый получился наложением синего и красного цветов). Следовательно, мы видим, что синего цвета у неушедших клиентов намного больше, поэтому можем сделать вывод о том, что наше предположение о том, что привлечение клиентов путем предложения им нашей акции, оказалось верным.

Давайте также посмотрим на интерактивную визуализацию наших данных до симуляции, чтобы понимать, насколько отличаются ушедшие и оставшиеся клиенты между с собой в рамках количества используемых продуктов.

library(crosstalk)
sharedData <- SharedData$new(final_exited)
bscols(widths = c(3,NA),
  list(
         filter_checkbox("status", "Ушел или нет", sharedData, ~Exited),
         filter_slider("credit score", "Кредитный скоринг", sharedData, ~CreditScore),
         filter_slider("age", "Возраст", sharedData, ~Age)
       ),
  plot_ly(sharedData, 
        x = ~CreditScore, y = ~Age, color = ~as.factor(NumOfProducts), 
        type = "scatter", 
        colors = "Set3")
)

Ушел или нет

0

1

Кредитный скоринг

Возраст

Дэшборд

В дэшборд я внесу два элемента:

• Интерактивную визуализацию с информацией о том, что клиентки (то есть женщины) уходят чаще из банка.

• Интерактивную визуализацию о том, насколько отличаются ушедшие и оставшиеся клиенты между с собой в рамках количества используемых продуктов.

Данный дэшборд полезен для понимания нашей “группы риска” и ее дальнейшего анализа. Дэшборд по большей части предназначен для аналитиков данных, которые после полученной информации должны будут спрогнозировать улучшения для данной выборки, чтобы уменьшить отток клиентов.

Общие выводы

Я провел кластеризацию, используя k.means и разбиение на 5 кластеров на основе нескольких переменных. В моем случае при установленном мною сиде получилось, что в 4 кластере все клиенты ушли из банка (что и является целевой переменной “Exited”). Еще в этом кластере интересны следующие переменные:

• возраст - он в среднем выше, чем в других кластерах

• кредитный скоринг клиента - он в среднем меньше, чем в других кластерах

• пол - в среднем чаще уходят женщины (вывод сделан на основе того, что Gender_Male меньше половины)

• есть ли кредитная карта - у ушедших клиентов в среднем меньше кредитных карт, чем в остальных кластерах, за исключением 5.

Поэтому я решил взять сегмент данных со следующими критериями:

1. Женщины

2. Возраст выше среднего

3. Кредитный скоринг меньше среднего

После выбора группы для анализа были построены две модели: дерево решений и логистическая регрессия. Для дальнейшей работы была выбрана логистическая регрессия, поскольку она выявила больше важных признаков. На основе модели была проведена симуляция количества продуктов, так как данная переменная значилась важной для регрессии и мы еще можем на нее повлиять. Результаты показали, что при использовании нашей “акции” (наш банк предлагает самые выгодные условия для открытия вклада на всем банковском рынке, если у клиента открыт счет или есть кредит в банке) увеличение количества продуктов позволило уменьшить отток клиентов. Задача всей работы выполнена!